COMMENT ⊗   VALID 00016 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	  FILES, SETNAM
C00005 00003	  Data structures:  Notes, note cells, message buffers
C00009 00004	  GETNOTE, SNDNOTE, SERVER
C00013 00005	  DOGTBUF, DOUSBUF, DORLBUF
C00015 00006	  LINKQUEUE, UNLQUE, SAMEID
C00018 00007	  TREATMESSAGE, GETOFS, DOERR, SNDANS
C00024 00008	  MAKREQ, SNDREQ
C00028 00009	  KTABLE, RTABLE, LOOKUP, RLOOKP, GETOCT, ascie messages
C00036 00010	   TACK, SKIPSP, SKIPOPT
C00038 00011	  DOGETVAL, DOSETVAL
C00047 00012	  DOWAIT, DOSIGNAL
C00052 00013	  DOSETNAM
C00056 00014	  DOSTART, DODDT, DONOTICE
C00062 00015	  Driver for test of communications, ALINIT, ALKILL
C00066 00016	  BUGS
C00067 ENDMK
C⊗;
;  FILES, SETNAM


.IFNDF ALAID
    DEBUG == 1
.IFF
    DEBUG == 0
.ENDC

KERNEL == 1
FLOAT == 1

.IFNZ DEBUG

;Set up the necessary mapping for the Zonker
	.INSRT ZONKER.PAL[AL,HE]

.OFFSET -160000		;Put ALAID in the Zonker

    .IF1
        .TITLE  Test of ALAID
        .INSRT ALHEAD.PAL[AL,HE]
        .INSRT K1DEF.PAL[11,SYS]
    .ENDC

. = PATCH
	.BLKW 200	;Patch area

	;If DDT sends us to user I space this will start the Kernel up anyway
. = START
	RESTRT		;EMT gets us into Kernel I space
	RESTRT
	RESTRT		;Kernel INIT entry point

. = INTRP

CODE$ == .		;Interpreter code & data spaces start here
DATA$ == .

    .INSRT ALIO.PAL[AL,HE]
    .INSRT FLOAT.PAL[AL,HE]
	STSW  LBDEBUG,1	;1 => first word of any large block is address of maker.
    .INSRT LARGEB.PAL[AL,HE]
    INSTSZ == 20    ;Size of an interpreter stack
.ENDC


.IFZ DEBUG
CODE
;  Special pseudo-ops

SETNAM:	;Interpreter code
	MOV @IPC(R4),INTNAM(R4)
	BMPIPC		;
	CCC		;Clear Condition Code
	RTS PC		;Done
.ENDC
;  Data structures:  Notes, note cells, message buffers

;  Notes from 10 to 11:
GETBUF == 1	;
USEBUF == 2	;
RELBUF == 3	;

;  Notes from 11 to 10:
BUFALC == 101	;
TAKBUF == 102	;

;  Offsets in notes:
ARG1 == 2
ARG2 == 4

;  Offsets in message buffers:
MESID == 0	;
MESTYP == 2	;
    FROMTEN == 1	;
    FROMELF == 2	;
    REQUEST == 4	;
    ANSWER == 10	;
MESLTH == 4	;
MESBEG == 6	;

;NOTB10  The notebox from 11 to the 10 (byte address) defined in COMTAB
;NOTB11  The notebox from 10 to the 11 (byte address) defined in COMTAB

NOTSIZ == 3		;  In WORDS!
BUFSIZ == 200		;  In WORDS!

DATA
NXTID:	.WORD 0	;Always even
CURNAM:	.WORD 0	;The current ISB for active interpreter.
ALLIVE:	.WORD 0	;AL interpreter alive if non-zero

;  Answer block:
	II == 0
	XX ANSBUF	;Points to a buffer for the return answer
	XX ANPTR	;Initialized to point to the start of the message in ANSBUF
	XX AGBUF	;Start of the request buffer
	XX AGARG	;Start of the arguments in request buffer
	XX AGPTR	;Points to the current place in the request
	XX VALPTR	;The value to be used in the answer
	XX GPHPTR	;The graph node to be used in the answer
	ABKSIZ == II/2	;Size of an answer block, in words.

;  Request block:
	II == 0
	XX REQBUF	;Place where the request will be assembled
	XX REQPTR	;Current end of the assembled request
	XX REQRES	;Where the response is placed
	XX REQEVT	;The event that will signal the return of the response
	XX REQQUE	;The queue node holding our waiting process
	RQBSIZ == II/2	;Size in WORDS.

;  Interlock event
ALDEVT:	.WORD 0

;  Waitqueue structure:
	II == 0
	XX QNEXT	;Next entry on queue
	XX QPREV	;Previous entry on queue
	   QID == II	;Identifier of this node.  Same field as QEVT.
	XX QEVT		;The event this waiter is expecting
	XX QBUF		;The answer he was waiting for
	QUELTH == II/2	;Length of queue node in WORDS.

WAITQ:	.BLKW QUELTH	;List of processes waiting to hear answers.

CODE
;  GETNOTE, SNDNOTE, SERVER

COMMENT ⊗ Since there is only one server, it is not necessary to put
any interlocks around code in GETNOTE and SNDNOTE.  ⊗

GETNOTE:
COMMENT ⊗ Returns the first note seen in a block pointed to by R0. ⊗
	MOV R2,-(SP)	;Save R2
1$:	TST NOTB11	;Anything there?
	BNE 2$		;Yes
	SLEEP #100	;and sleep a while
	TST ALLIVE	;See if the main interpreter has gone away
	BNE 1$		;if not try again
	DISMIS		;if so we should die
2$:	MOV #NOTSIZ,R0	;
	MOV R0,R2	;R2 ← Count of how many words to transfer
	JSR PC,GTFREE	;R0 ← place to store the note
	MOV #NOTB11,R1	;Transfer the note
3$:	MOV (R1)+,(R0)+
	SOB R2,3$	;Repeat
	SUB #2*NOTSIZ,R0	;Reset R0 to point to front of note.
	CLR NOTB11	;Clear the note, to say we got it.
	MOV (SP)+,R2	;Restore R2
	RTS PC		;Done

SNDNOTE:
COMMENT ⊗ R0 points to a note to send.  Send it and then release the
block. ⊗
	MOV R2,-(SP)	;Sve R2
1$:	TST NOTB10	;Anything there?
	BEQ 2$		;No.
	SLEEP #100	;Yes, so sleep a while
	BR  1$		;And try again
2$:	MOV #NOTSIZ-1,R1	;R1 ← count of words to send
	MOV #NOTB10+2,R2;R2 ← Where to put it.
	TST (R0)+	;Skip the first word; we will put it in last
3$:	MOV (R0)+,(R2)+
	SOB R1,3$	;Repeat
	SUB #2*NOTSIZ,R0	;Reset R0 ← LOC[note]
	MOV (R0),NOTB10	;Activate the note by sending the first word
	JSR PC,RLFREE	;Release the block.
	MOV (SP)+,R2	;Restore R2
	RTS PC		;Done

SERVER:
COMMENT ⊗ Listens for notes from the 10 and acts on them.  Never
returns. Uses R2. ⊗
	JSR  PC,GETNOTE	;R0 ← LOC[note]
	MOV (R0),R1	;R1 ← type of note
	MOV R0,R2 	;R2 ← LOC[note]

	CMP R1,#GETBUF	;GETBUF
	BNE 1$ 
	JSR PC,DOGTBUF	;
	BR 4$		;
1$:
	CMP R1,#USEBUF	;USEBUF
	BNE 2$
	JSR PC,DOUSBUF	;
	BR 4$		;
2$:
	CMP R1,#RELBUF	;RELBUF
	BNE 3$
	JSR PC,DORLBUF	;
	BR 4$		;
3$:
	ALERR SRVMES 	;Illegal code

4$:	MOV R2,R0	;Release the note.
	JSR PC,RLFREE	;
	BR SERVER	;One more river, there's one more river to cross.

DATA
SRVMES:	ASCIE </CAN'T UNDERSTAND NOTE FROM THE 10/>
CODE

;  DOGTBUF, DOUSBUF, DORLBUF

DOGTBUF:
COMMENT ⊗ Called by SERVER.  The 10 wants us to allocate a buffer.
R0 = LOC[note].  The size in bytes is in ARG1(R0).  We should respond
with BUFALC <size> <adr>.  ⊗
	MOV ARG1(R0),R0	;R0 ← size argument
	MOV R0,-(SP)	;Save size argument
	JSR  PC,GTFREE	;Get the buffer out of free storage
	MOV R0,-(SP)	;Save buffer address
	MOV #NOTSIZ,R0	;
	JSR PC,GTFREE	;R0 ← LOC[new note to send]
	MOV #BUFALC,(R0)	;BUFALC
	MOV (SP)+,ARG2(R0) 	;  <adr>
	MOV (SP)+,ARG1(R0) 	;  <size>
	JSR PC,SNDNOTE	;Send the note off. (He will destroy it)
	RTS PC		;Done

DOUSBUF:
COMMENT ⊗ Called by SERVER.  R0 = LOC[note].  The buffer that starts
at address ARG1(R0) is a message.  Look at it, act on it, and then
recycle the message buffer.  ⊗
	MOV ARG1(R0),R0	;R0 ← LOC[message]
	JSR PC,TREATMESSAGE	;Treat it and release it
	RTS PC		;Done

DORLBUF:
COMMENT ⊗ Called by SERVER.  R0 = LOC[note].  The buffer that starts
at ARG1(R0) has been used by the 10, and we may deallocate it now. ⊗
	MOV ARG1(R0),R0	;R0 ← LOC[expended message]
	JSR PC,RLFREE	;
	RTS PC		;Done

;  LINKQUEUE, UNLQUE, SAMEID

LINKQUEUE:
COMMENT ⊗ There is a dummy queue at the start of the chain.  R1
points to the queue header, and R0 is the one we wish to add in.  
Exclusion should be on before this routine is called; it remains
on afterwards.  ⊗
	MOV QNEXT(R1),QNEXT(R0)
	MOV R1,QPREV(R0)
	MOV R0,QNEXT(R1)
	RTS PC

UNLQUE:
COMMENT ⊗ R0 points to a queue node.  It is unlinked from its queue.
R0 is left pointing at the same node.  Exclusion should be on before
this routine is called; it will remain on afterwards.  ⊗
	MOV QPREV(R0),R1	;R1 ← prev(old)
	MOV QNEXT(R0),QNEXT(R1)	;Transfer forward link.
	MOV QNEXT(R0),R1	;R1 ← next(old)
	BEQ 1$			;If any
	MOV QPREV(R0),QPREV(R1)	;Transfer backward link.
1$:	RTS PC			;Done.


SAMEID:
COMMENT ⊗ R0 = header of queue.  R1 = ID to look for.  If there is a
node in the queue with that ID, it is returned in R0.  Otherwise, R0
← 0.  Exclusion should be on before this routine is called; it will
remain on afterwards.  ⊗
1$:	MOV QNEXT(R0),R0	;R0 ← next (real) node in queue
	BEQ 2$			;If any.
	CMP QID(R0),R1		;Match the ID?
	BNE 1$			;No.  Try next one.
	JSR PC,UNLQUE		;R0 ← same node, now unlinked.
2$:	RTS PC			;Done

;  TREATMESSAGE, GETOFS, DOERR, SNDANS

TREATMESSAGE:
COMMENT ⊗ R0 = LOC[buffer from the 10].  Print out its contents and
treat it.  ⊗
	MOV R2,-(SP)	;Save R2
	MOV R0,R2	;R2 ← LOC[buffer]

	;print the message
   .IFZ DEBUG
	EVWAIT CSLEVT	;
   .ENDC
	MOV #CRLFX,R0	;
	JSR PC,TYPSTR	;
	MOV R2,R0	;
	ADD #MESBEG,R0	;R0 ← LOC[start of message itself]
	JSR PC,TYPSTR	;Print it
   .IFZ DEBUG
	EVSIG CSLEVT	;
   .ENDC

	;see what kind of message it is
	MOV R2,R0	;
	MOV MESTYP(R0),R1	;R1 ← MESTYPE;
	BIT #ANSWER,R1	;An  answer?
	BEQ 2$		;No
	

	;got a response.  See if anyone is waiting to hear it.
	MOV MESID(R0),R1;R1 ← MESID
	EVWAIT ALDEVT	;Enter critical section
	MOV #WAITQ,R0	;R0 ← head of wait.
	JSR PC,SAMEID	;R0 ← queue node waiting for this MESID.
	EVSIG ALDEVT	;End of critical section
	TST R0		;Was there a waiting process?
	BNE 1$		;Yes.
	ALERR TRTMMS	;None found.  A bug!
1$:	MOV R2,QBUF(R0)	;Give him his result.
	EVSIG QEVT(R0)	;Give him his signal
	BR 3$		;Prepare to leave
	
	;got a question.  Get someone to look at it.
2$:	JSR PC,RLOOKP	;Start up a process to fulfill the request and
			;delete the message

3$:	MOV (SP)+,R2	;Restore R2
	RTS PC		;

DATA
TRTMMS:	ASCIE </GOT UNEXPECTED ANSWER FROM THE 10./>
CODE

GETOFS:	
COMMENT ⊗ R2 = LOC[answer block].  We want to see (OFFSET n).  If we
do, we put LOC[graph node for n] in GPHPTR(R2); otherwise R0 ← 0.  R2 is
still LOC[answer block], but ARGPTR is properly updated. ⊗
	MOV AGARG(R2),R0;R0 ← LOC[argument string]
	CMPB (R0)+,#'(	;A left paren?
	BNE 1$		;No.  
	JSR PC,LOOKUP	;R0 ← next thing on arg, R1 ← OFSCOD, we hope.
	CMP R1,#OFSCOD	;Was it offset?
	BNE 1$		;No.
	JSR PC,GETOCT	;R0 ← after the arg, R1 ← octal number found.
	MOV R0,AGPTR(R2);Save arg. ptr
	MOV R1,R0	;R0 ← integer offset
	MOV CURNAM,R4	;R4 ← LOC[ISB of active interpreter]
	JSR PC,GETARG	;R0 ← LOC[environment entry for variable]
	MOV R0,GPHPTR(R2)
	BEQ 1$		;If anyone home.  Else will return failure.
	MOV AGPTR(R2),R0;
	JSR PC,SKIPSP	;Skip spaces.
	MOV #'),R1	;
	JSR PC,SKIPOP	;Skip the ), if it is there.
	MOV R0,AGPTR(R2);
	RTS PC		;
1$:	CLR R0		;Failure return
	RTS PC		;

DOERR:	
COMMENT ⊗ There has been an error in parsing some command. R2 =
LOC[answer block].  We will say "ERROR (message)".  R2 will be left
with ANPTR fixed up.  ⊗
	MOV ANPTR(R2),R0;R0 ← answer pointer
	MOV #ERRMES,R1	;
	JSR PC,TACK	;Tack on "ERROR "
	MOV #LPAREN,R1	;
	JSR PC,TACK	;Tack on " ( "
	MOV AGBUF(R2),R1;
	ADD #MESBEG,R1	;
	JSR PC,TACK	;Tack on the original message
	MOV #RPAREN,R1	;
	JSR PC,TACK	;Tack on " ) "
	MOV R0,ANPTR(R2);
	JMP SNDANS	;He will never return.

SNDANS:
COMMENT ⊗ R2 = LOC[answer block]. ANPTR(R2) = end of the message.
ANSBUF(R2) = front of the message.  Compute the message length, send
the message out, reclaim the answer block, including the AGBUF, and
then reclaim the interpreter stack, the PDB of this process and
dismiss. ⊗

	;compute MESLTH
	MOV ANPTR(R2),R1;R1 ← ans. ptr
	MOV ANSBUF(R2),R0	;R0 ← LOC[answer buffer]
	SUB R0,R1	;R1 ← length in bytes of message
	ASR R1		;in words
	MOV R1,MESLTH(R0); MESLTH

	;send the result back.  R0 = LOC[message]
	MOV #NOTSIZ,R0	;
	JSR PC,GTFREE	;R0 ← LOC[new note to send]
	MOV #TAKBUF,(R0);TAKBUF
	MOV (SP),R1	;R1 ← LOC[answer block]
	MOV ANSBUF(R2),ARG1(R0)	;  <adr>
	JSR PC,SNDNOTE	;Send the note off. (He will destroy it)

	;reclaim answer block
	MOV R2,R0	;Reclaim the argument message buffer
	MOV AGBUF(R0),R0;
	JSR PC,RLFREE	;
	MOV R2,R0	;Reclaim the answer block itself
	JSR PC,RLFREE	;

	;reclaim interpreter stack
	MOV R3,R0
	SUB #2*INSTSZ,R0
	JSR PC,RLFREE

	;reclaim Processor Desriptor Block
	MOV R5,R0	;
	JSR PC,RLFREE	;
	DISMIS		;Gone!

;  MAKREQ, SNDREQ

MAKREQ:	
COMMENT ⊗ Returns in R3 a pointer to a brand new request block, with
REQBUF and REQPTR initialized to a new area for assembling a request.
The REQBUF is initialized with MESTYP.  ⊗
	MOV #RQBSIZ,R0	;Get a request block
	JSR PC,GTFREE	;
	MOV R0,R3	;R3 ← LOC[request block]
	MOV #BUFSIZ,R0	;
	JSR PC,GTFREE	;R0 ← LOC[request buffer]
	MOV #FROMELF+REQUEST,MESTYP(R0)
	MOV R0,REQBUF(R3)
	ADD #MESBEG,R0	;
	MOV R0,REQPTR(R3)
	RTS PC		;

SNDREQ:
COMMENT ⊗ R3 = LOC[request block]. REQPTR(R3) = end of the message.
REQBUF(R3) = front of the message.  Compute the message length, send
the message out, wait for a reply, and then put the response in
REQRES(R3).  R3 is left pointing to the request block.  ⊗

	;compute MESLTH
	MOV REQPTR(R3),R1	;R1 ← ans. ptr
	MOV REQBUF(R3),R0	;R0 ← LOC[request buffer]
	SUB R0,R1	;R1 ← length in bytes of message
	ASR R1		;in words
	MOV R1,MESLTH(R0); MESLTH

	MOV REQBUF(R3),R0	;R0 ← LOC[message buffer]
	EVMAK		;Get an event that will signal the response to the request.
 	MOV (SP),MESID(R0)	;That will be the MESID.
	MOV (SP)+,REQEVT(R3)	;REQEVT

	MOV #QUELTH,R0	;Enqueue ourselves for the response
	JSR PC,GTFREE	;R0 ← LOC[queue node]
	MOV R0,REQQUE(R3)	;REQQUE
	MOV REQEVT(R3),QEVT(R0)	;QEVT
	EVWAIT ALDEVT	;Enter critical region
	MOV #WAITQ,R1	;
	JSR PC,LINKQUEUE;
	EVSIG ALDEVT	;Leave critical region

	;send the request out.  R0 = LOC[message]
	MOV #NOTSIZ,R0	;
	JSR PC,GTFREE	;R0 ← LOC[new note to send]
	MOV #TAKBUF,(R0);TAKBUF
	MOV REQBUF(R3),ARG1(R0)	;  <adr>
	JSR PC,SNDNOTE	;Send the note off. (He will destroy it)
	EVWAIT REQEVT(R3)	;Wait for the event to happen

        COMMENT ⊗ When the answer comes, the server will unlink the
        queue for us.  We must destroy the event and reclaim the
        queue node ourselves.  ⊗

	;the response has come, and the answer is in QBUF(REQQUE(R3))
	EVKIL REQEVT(R3)	;
	MOV REQQUE(R3),R0	;
	MOV QBUF(R0),REQRES(R3)	;REQRES
	JSR PC,RLFREE		;Release the queue node
	RTS PC		;
;  KTABLE, RTABLE, LOOKUP, RLOOKP, GETOCT, ascie messages

DATA
LPAREN:	.ASCIZ / ( /
RPAREN:	.ASCIZ / ) /
DONEMES:.ASCIZ /DONE /
ERRMES:	.ASCIZ /ERROR /
YTHMES:	.ASCIZ /YOUTHERE /
	.EVEN

	.MACRO KWORD KNAME, KINFO
	II == .
	ASCIE /KNAME/
	. = II + 6	;Truncate to 6 characters
	KINFO		;Either code for this keyword, or service routine address
	.ENDM
	
OFSCOD == 1
SCACOD == 2
VCTCOD == 3
TRACOD == 4
PLCCOD == 5

KTABLE:	;List of keywords.
	KWORD <OFFSET>, OFSCOD
	KWORD <SCALAR>, SCACOD
	KWORD <VECTOR>, VCTCOD
	KWORD <TRANS >, TRACOD
	KWORD <PLACE >, PLCCOD
KTEND:	.WORD 0

RTABLE:	;List of requests.
	KWORD <GETVAL>, DOGETVAL
	KWORD <SETVAL>, DOSETVAL
	KWORD <SIGNAL>, DOSIGNAL
	KWORD <WAIT  >, DOWAIT
	KWORD <SETNAM>, DOSETNAM
	KWORD <START >, DOSTART
	KWORD <DDT   >, DODDT
	KWORD <NOTICE>, DONOTICE
RTEND:	.WORD 0
CODE

COMMENT ⊗ R0 = LOC[string]. Find which keyword heads the string,
using a disgusting linear search, and return R1 ← 0 if no keyword
found, otherwise R1 ← code for that keyword.  R0 ← next entry on
string. ⊗

LOOKUP:	
	MOV R2,-(SP)	;Save R2
	MOV #KTABLE,R1	;R1 ← LOC[current try in KTABLE]
1$:	MOV #6,R2	;R2 ← count of how many characters to match.
2$:	CMPB (R0)+,(R1)+;Match the next letter?
	BEQ 4$		;Yes
3$:	ADD R2,R0	;
	SUB #7,R0	;R0 ← start of given string.
	ADD R2,R1	;R1 ← end of test string
	TSTB (R1)+	;R1 ← start of next test string
	CMP R1,#KTEND	;Off the end?
	BLO 1$		;No.
	BR 6$		;Yes.
4$:	SOB R2,2$	;Try the next, if any.
	;found a match.  R1 = LOC[KINFO]
	JSR PC,SKIPSP 	;Skip spaces (does not hurt R1)
	MOV (R1),R1	;R1 ← KINFO
5$:	MOV (SP)+,R2	;Restore R2
	RTS PC		;Done
6$:	CLR R1		;Did not find anything
	BR 5$		;

COMMENT ⊗ R0 = LOC[message buffer request]. Find which request word
heads the string, using a disgusting linear search, and start a
process to handle the request.  He will see to the deletion of the
message buffer.  ⊗

RLOOKP:	
	MOV R2,-(SP)	;Save R2
	MOV R0,-(SP)	;Save LOC[message buffer request]
	ADD #MESBEG,R0	;R0 ← LOC[request string]
	MOV #RTABLE,R1	;R1 ← LOC[current try in KTABLE]
1$:	MOV #6,R2	;R2 ← count of how many characters to match.
2$:	CMPB (R0)+,(R1)+;Match the next letter?
	BEQ 4$		;Yes
3$:	ADD R2,R0	;
	SUB #7,R0	;R0 ← start of given string.
	ADD R2,R1	;R1 ← end of test string
	TSTB (R1)+	;R1 ← start of next test string
	CMP R1,#RTEND	;Off the end?
	BLO 1$		;No.
	MOV #DOERR,R2	;So what we will do is handle the error.
	BR 5$
4$:	SOB R2,2$	;Try the next, if any.
	;found a match.  R1 = LOC[KINFO]
	MOV (R1),R2	;R2 ← KINFO = address of service routine
5$:	JSR PC,SKIPSP 	;Skip spaces
	MOV R0,-(SP)	;Save AGPTR

	;build the answer block
	MOV #BUFSIZ,R0	
	JSR PC,GTFREE	;R0 ← LOC[answer buffer]
	MOV 2(SP),R1	;R1 ← AGBUF
	MOV MESID(R1),MESID(R0)	;Transfer the MESID to answer from request.
	MOV #FROMELF+ANSWER,MESTYP(R0)	;MESTYP
	MOV R0,-(SP)	;Save ANSBUF
	MOV #ABKSIZ,R0	;Get an answer block
	JSR PC,GTFREE	;R0 ← LOC[answer block]
	MOV (SP)+,R1	;R1 ← ANSBUF
	MOV R1,ANSBUF(R0)
	ADD #MESBEG,R1	;
	MOV R1,ANPTR(R0);
	MOV (SP),AGARG(R0)
	MOV (SP)+,AGPTR(R0)
	MOV (SP)+,AGBUF(R0)
	MOV R0,-(SP)	;Save LOC[answer block]

	;set up a new process with R2 ← LOC[answer block] to fulfil request.
	INSTSZ == 20	;Size of an interpreter stack
	MOV #INSTSZ,R0	;R3 stack space
	JSR PC,GTFREE	;
	ADD #2*INSTSZ,R0	;to end of space
	MOV R0,-(SP)	;Save stack space
	MOV #210,R0	;Room for process descriptor
	JSR PC,GTFREE	;R0 ← LOC[new process descriptor]
	MOV #UFPUSE+UGRSAV+4,PDBSTA(R0);Use floating point, use saved registers.
	MOV R0,USKMIN(R0)	;Set up min pointer for SP
	ADD #UFEC+36,USKMIN(R0)
	MOV R0,USKMAX(R0)	;Set up max pointer for SP
	ADD #420,USKMAX(R0)
	MOV #144100,UPSW(R0)	;Set up psw
	MOV (SP)+,PDBR3(R0)	;Store away the R3 stack pointer.
	MOV (SP)+,PDBR2(R0)	;Store away the R2 = LOC[answer block]
	MOV CURNAM,PDBR4(R0)	;Start out on the current ISB
	MOV R0,PDBR5(R0)	;Store away the R5 = PDB address.
	MOV #USRIM,UIMAP(R0)	;Map instruction space
	FORK R0,R2,#USRDM	;Cause the new process to be started

6$:	MOV (SP)+,R2	;Restore R2
	RTS PC		;Done

GETOCT:
COMMENT ⊗ R0 = string pointer.  Finds an octal number, skipping
spaces to do so, and places its value in R1.  Leaves R0 at end of
spaces following the string. ⊗
	MOV R2,-(SP)	;Save R2
	CLR R1		;R1 is the eventual result
	JSR PC,SKIPSP	;Skip leading spaces
1$:	MOVB (R0)+,R2	;R2 ← Character
	CMP #'0,R2	;Too small?
	BGT 2$		;yes
	CMP #'7,R2	;Too large?
	BGE 3$		;no
2$:	TSTB -(R0)	;Move back one place
	JSR PC,SKIPSP	;skip trailing spaces
	MOV (SP)+,R2	;Restore R2
	RTS PC		;Done
3$:	MOV R2,-(SP)	;Save the character
	ASH #3,R1	;Compute new result
	BIC #60,(SP)	;
	ADD (SP)+,R1	;
	BR  1$		;And repeat
   TACK, SKIPSP, SKIPOPT

TACK:
COMMENT ⊗ R1 = LOC[ascie string to tack on], R0 = LOC[where to put
it].  Returns R0 ← next location available in destination string.  ⊗
	MOVB (R1)+,(R0)+;Copy a byte
	BNE TACK	;Repeat while necessary
	DEC R0		;Go back past the null
	RTS PC		;Done

SKIPSP:
COMMENT ⊗ R0 = LOC[string].  Skip past any spaces, returning R0 ← LOC[next
non-space element of the string.  Leaves R1 unchanged.  ⊗
	CMPB (R0)+,#' 	;
	BEQ SKIPSP	;
	DEC R0		;Go back past the non-space
	RTS PC		;

SKIPOPT:
COMMENT ⊗ R0 = LOC[string].  Skip past the character in R1, if it is
the next character, and in any case, skip past any spaces.  ⊗
	CMPB (R0),R1	;The optional character?
	BNE 1$		;No
	TSTB (R0)+	;Yes.  Skip it.
1$:	JMP SKIPSP	;Skip over spaces, and let SKIPSP return.

;  DOGETVAL, DOSETVAL

COMMENT ⊗ All service routines are instantiated as processes, where
R2 points at an answer block, with ANPTR, ANSBUF, AGBUF, AGPTR, AGARG
all set up.  The ANSBUF already has MESID and MESTYP set.  R3 points
at an interpreter stack, if it should be needed, and R5 points at the
PDB, for reclamation purposes.  Service routines dismiss when they
are finished, having destroyed their PDB. ⊗

DOGETVAL:	;Service routine
COMMENT ⊗ Currently accepted argument string is: (OFFSET n).  The
OFFSET construct will cause that variable in the current interpreter
to have its value produced.  The answer is of the form "ISVAL arg
val", unless something goes wrong, in which case the answer will be
"ERROR (GETVAL arg)".  ⊗

	;scan the arguments
	JSR PC,GETOFS	;GPHPTR(R2) ← LOC[environment entry for offset]
	TST R0		;or was there an error?
	BEQ 3$		;oops.
	MOV GPHPTR(R2),R0	;R0 ← LOC[Env entry]
	TSTB 1(R0)	;Check accessing method
	BNE 1$
	MOV 2(R0),VALPTR(R2)	;Direct access - store away LOC[value]
	BR 2$
1$:	CALL GETVAL,<2(R0)>	;Indirect access - R0 ← LOC[value]
	MOV R0,VALPTR(R2)	;
2$:	MOV AGPTR(R2),R0;
	TSTB (R0)	;At the end?
	BNE 3$		;No.  extra arguments.

	;prepare the answer. Note that TACK and TACKVAL take a string pointer
	; in R0 and leave it right afterwords.
	MOV ANPTR(R2),R0	;R0 ← answer pointer
	MOV VALPTR(R2),R1	;R0 ← LOC[value]
	JSR PC,TACKVAL	;Tack it on
	MOV R0,ANPTR(R2);
	BR 4$		;Ready to send it back

	;In this case, cannot make sense of the argument.
3$:	JMP DOERR	;

4$:	;ANPTR(R2) = end of the message.  ANSBUF(R2) = front of the message
	JMP SNDANS	;Send it winging on its way. Reclaim the answer block.
			;Reclaim the PDB.  Dismiss.

DOSETVAL:
COMMENT ⊗ Currently accepted argument string is: (OFFSET n) (SCALAR
n.n), (VECTOR n n n), or (TRANS n n ... n).  The variable specified
by the first argument has its value changed to the value given by the
second argument.  The answer is of the form "DONE", unless something
goes wrong, in which case the answer will be "ERROR (SETVAL args)".
⊗

	;scan the arguments
	JSR PC,GETOFS	;GPHPTR(R2) ← LOC[environment entry for offset]
	TST R0		;or was there an error?
	BEQ 7$		;oops.
	CMPB (R0)+,#'(	;A left paren?
	BNE 7$		;No.  
	JSR PC,LOOKUP	;R0 ← next thing on arg, R1 ← SCLCOD, we hope.
	CMP R1,#SCACOD	;Was it SCALAR?
	BNE 1$		;No.
	JSR PC,RELSCN	;R0 ← after the arg, R1 ← 0 <=> number, AC0 ← float rep.
	MOV R0,AGPTR(R2);Save arg. ptr
	TST R1		;Number?
	BNE 7$		;No
	JSR PC,GETSCA	;R0 ← -(R3) ← LOC[scalar cell]
	MOV (R3)+,VALPTR(R2)
	STF AC0,(R0)	;Put 'er in.
	BR 5$

1$:	CMP R1,#VCTCOD	;Was it VECTOR?
	BNE 3$		;No.
	MOV R0,AGPTR(R2);Save arg. ptr
	JSR PC,GETVEC	;R0 ← -(R3) ← LOC[trans cell]
	MOV (R3)+,VALPTR(R2)
	MOV R3,-(SP)	;Save R3
	MOV R4,-(SP)	;Save R4
	MOV R0,R4	;R4 ← LOC[vector cell]
	MOV #3,R3	;R3 ← count of how many places in VECTOR to fill.
	MOV AGPTR(R2),R0;
2$:	JSR PC,RELSCN	;R0 ← after the arg, R1 ← 0 <=> number, AC0 ← float rep.
	TST R1		;Number?
	BNE 6$		;No
	STF AC0,(R4)+	;Put 'er in.
	SOB R3,2$	;Repeat
	MOV ONE,(R4)+	;Set weight to one
	MOV R0,AGPTR(R2);
	MOV (SP)+,R4	;Restore R4
	MOV (SP)+,R3	;Restore R3
	BR 5$

3$:	CMP R1,#TRACOD	;Was it TRANS?
	BNE 7$		;No.
	MOV R0,AGPTR(R2);Save arg. ptr
	JSR PC,GETTRN	;R0 ← -(R3) ← LOC[trans cell]
	MOV (R3)+,VALPTR(R2)
	MOV R3,-(SP)	;Save R3
	MOV R4,-(SP)	;Save R4
	MOV R0,R4	;R4 ← LOC[trans cell]
	MOV #14,R3	;R3 ← count of how many places in TRANS to fill.
	MOV AGPTR(R2),R0;
4$:	JSR PC,RELSCN	;R0 ← after the arg, R1 ← 0 <=> number, AC0 ← float rep.
	TST R1		;Number?
	BNE 6$		;No
	STF AC0,(R4)+	;Put 'er in.
	SOB R3,4$	;Repeat
	MOV R0,AGPTR(R2);
	MOV (SP)+,R4	;Restore R4
	MOV (SP)+,R3	;Restore R3

5$:	MOV GPHPTR(R2),R1	;R1 ← LOC[environment entry]
	TSTB 1(R1)		;Check if direct access
	BNE 10$			;  nope
	MOV VALPTR(R2),2(R1)	;  Yes - store value pointer in environment
	BR 11$
10$:	CALL CHANGE,<2(R1),VALPTR(R2)>
11$:	MOV AGPTR(R2),R0;R0 ← arg. ptr.
	JSR PC,SKIPSP	;Scan past spaces
	MOVB #'),R1	;
	JSR PC,SKIPOPT	;Skip right paren, if any, plus spaces
	TSTB (R0)	;At the end?
	BNE 7$		;No.  extra arguments.

	;prepare the answer. Note that TACK and TACKVAL take a string pointer
	; in R0 and leave it right afterwords.
	MOV ANPTR(R2),R0	;R0 ← answer pointer
	MOV #DONEMES,R1	;
	JSR PC,TACK	;Tack on "DONE "
	MOV R0,ANPTR(R2);
	BR 8$		;Ready to send it back

	;in this case, trying to scan a number and failed.
6$:	MOV (SP)+,R4	;Restore R4
	MOV (SP)+,R3	;Restore R3

	;In this case, cannot make sense of the argument.
7$:	JMP DOERR	;

8$:	;ANPTR(R2) = end of the message.  ANSBUF(R2) = front of the message
	JMP SNDANS	;Send it winging on its way. Reclaim the answer block.
			;Reclaim the PDB.  Dismiss.
;  DOWAIT, DOSIGNAL;

DOSIGNAL:	;Service routine
COMMENT ⊗ Currently accepted argument string is: (OFFSET n).  The
OFFSET construct will cause that variable in the current interpreter
to be signaled.  The answer is of the form "DONE", unless something
goes wrong, in which case the answer will be "ERROR (SIGNAL arg)".  ⊗

	;scan the arguments
	JSR PC,GETOFS	;GPHPTR(R2) ← LOC[environment entry for event]
	TST R0		;or was there an error?
	BEQ 1$		;oops.
	MOV GPHPTR(R2),R0
	EVSIG 2(R0)	;Signal the event.
	MOV AGPTR(R2),R0;
	TSTB (R0)	;At the end?
	BNE 1$		;No.  extra arguments.

	;prepare the answer. Note that TACK and TACKVAL take a string pointer
	; in R0 and leave it right afterwords.
	MOV ANPTR(R2),R0	;R0 ← answer pointer
	MOV #DONEMES,R1	;
	JSR PC,TACK	;Tack on "DONE "
	MOV R0,ANPTR(R2);
	BR 2$		;Ready to send it back.

	;In this case, cannot make sense of the argument.
1$:	JMP DOERR	;

2$:	;ANPTR(R2) = end of the message.  ANSBUF(R2) = front of the message
	JMP SNDANS	;Send it winging on its way. Reclaim the answer block.
			;Reclaim the PDB.  Dismiss.

DOWAIT:	;Service routine
COMMENT ⊗ Currently accepted argument string is: (OFFSET n).  The
OFFSET construct will cause that variable in the current interpreter
to be waited.  The answer is of the form "DONE" when the wait is up,
unless something goes wrong, in which case the answer will be "ERROR
(WAIT arg)".  ⊗

	;scan the arguments
	JSR PC,GETOFS	;GPHPTR(R2) ← LOC[environment entry for event]
	TST R0		;or was there an error?
	BEQ 1$		;oops.
	MOV GPHPTR(R2),R0
	EVWAIT 2(R0)	;WAIT for the event.
	MOV AGPTR(R2),R0;
	TSTB (R0)	;At the end?
	BNE 1$		;No.  extra arguments.

	;prepare the answer. Note that TACK and TACKVAL take a string pointer
	; in R0 and leave it right afterwords.
	MOV ANPTR(R2),R0	;R0 ← answer pointer
	MOV #DONEMES,R1	;
	JSR PC,TACK	;Tack on "DONE "
	MOV R0,ANPTR(R2);
	BR 2$		;Ready to send it back.

	;In this case, cannot make sense of the argument.
1$:	JMP DOERR	;

2$:	;ANPTR(R2) = end of the message.  ANSBUF(R2) = front of the message
	JMP SNDANS	;Send it winging on its way. Reclaim the answer block.
			;Reclaim the PDB.  Dismiss.
;  DOSETNAM

DOSETNAM:	;Service routine
COMMENT ⊗ Currently accepted argument string is: "n".  the
interpreter with that name will be selected, and its ISB placed in
R4.  The answer is of the form "DONE" when the wait is up, unless
something goes wrong, in which case the answer will be "ERROR (SETNAM
arg)".  ⊗

	;scan the arguments
	MOV AGPTR(R2),R0;
	JSR PC,GETOCT	;R0 ← after the arg, R1 ← octal number seen
	MOV R0,AGPTR(R2);Save arg. ptr
	MOV R1,-(SP)	;Stack interpreter name
	EVWAIT INTEVT	;Enter critical section
	MOV #ISTBLK,R0	;Find the right interpreter.
1$:	MOV R0,R1	;
	MOV NXTINT(R1),R0;
	BEQ 2$		;No such interpreter.
	CMP INTNAM(R0),(SP)	;Have we found ours yet?
	BNE 1$		;No.  Try again.
	EVSIG INTEVT	;End of critical section
	TST (SP)+	;Get rid of the interpreter name.
	MOV R0,CURNAM	;CURNAM ← ISB of new interpreter
	MOV AGPTR(R2),R0;
	TSTB (R0)	;At the end?
	BNE 3$		;No.  extra arguments.

	;prepare the answer. Note that TACK and TACKVAL take a string pointer
	; in R0 and leave it right afterwords.
	MOV ANPTR(R2),R0	;R0 ← answer pointer
	MOV #DONEMES,R1	;
	JSR PC,TACK	;Tack on "DONE "
	BR 4$		;Ready to send it back.

	;No such interpreter
2$:	EVSIG INTEVT	;End of critical secton

	;In this case, cannot make sense of the argument.
3$:	JMP DOERR	;

4$:	;ANPTR(R2) = end of the message.  ANSBUF(R2) = front of the message
	JMP SNDANS	;Send it winging on its way. Reclaim the answer block.
			;Reclaim the PDB.  Dismiss.
;  DOSTART, DODDT, DONOTICE

DOSTART:	;Service routine
COMMENT ⊗ Currently accepted argument string is: (PLACE n), which is
optional.  A new interpreter is started up, either at n or at PCODE,
if the argument is missing.  This new interpreter becomes the
selected interpreter.  The answer is of the form "DONE", unless
something goes wrong, in which case the answer will be "ERROR (START
arg)".  ⊗

	;scan the arguments
	MOV AGPTR(R2),R0;
	TSTB (R0)+,#'(	;An argument?
	BEQ 1$
	JSR PC,LOOKUP	;
	CMP R1,#PLCCOD	;A place?
	BNE 3$		;No.  Illegal argument
	JSR PC,GETOCT	;R0 ← after the arg, R1 ← number seen.
	MOV R0,AGPTR(R2);Save arg. ptr
	MOV R1,R0	;R0 ← interpreter start address
	BR 2$
1$:	MOV #PCODE,R0	;R0 ← interpreter start address
2$:	CLR R1		;No particular event when he is finished.
	JSR PC,SPAWN	;R0 ← PDB[new interpreter process].
	MOV PDBR4(R0),CURNAM	;Set current interpreter to this one.
	SCHEDU R0,#INTERP,#USRDM,#2 ;Cause the new process to be started, suspended

	;prepare the answer. Note that TACK and TACKVAL take a string pointer
	; in R0 and leave it right afterwords.
	MOV ANPTR(R2),R0	;R0 ← answer pointer
	MOV #DONEMES,R1	;
	JSR PC,TACK	;Tack on "DONE "
	MOV R0,ANPTR(R2);
	BR 4$		;Ready to send it back.

	;In this case, cannot make sense of the argument.
3$:	JMP DOERR

4$:	;ANPTR(R2) = end of the message.  ANSBUF(R2) = front of the message
	JMP SNDANS	;Send it winging on its way. Reclaim the answer block.
			;Reclaim the PDB.  Dismiss.

DODDT:	;Service routine
COMMENT ⊗ Jump to DDT, so that ↑P will proceed. The answer is of the
form "DONE", unless something goes wrong, in which case the answer
will be "ERROR (DDT arg)".  ⊗

	ALERR DODDTMES	;Here we go to DDT.

	;test stuff.  Current test:  Try the turn-around question YOUTHERE
	;at the ten.
	MOV R3,-(SP)	;Save R3
	JSR PC,MAKREQ	;R3 ← request block.
	MOV REQPTR(R3),R0	;R0 ← REQPTR
	MOV #YTHMES,R1	;Tack on "YOUTHERE"
	JSR PC,TACK	;
	MOV R0,REQPTR(R3)
	JSR PC,SNDREQ	;Send the request on its way, and eventually come back
			;with response in the REQRES(R3)
	MOV REQRES(R3),R0	;
	ADD #MESBEG,R0	;Print out the response
	JSR PC,TYPSTR	;
	MOV REQRES(R3),R0	;Reclaim the response buffer
	JSR PC,RLFREE	;
	MOV R3,R0	;Reclaim request block
	JSR PC,RLFREE	;
	MOV (SP)+,R3	;Restore R3

	;prepare the answer. Note that TACK and TACKVAL take a string pointer
	; in R0 and leave it right afterwords.
	MOV ANPTR(R2),R0	;R0 ← answer pointer
	MOV #DONEMES,R1	;
	JSR PC,TACK	;Tack on "DONE "

	;ANPTR(R2) = end of the message.  ANSBUF(R2) = front of the message
	JMP SNDANS	;Send it winging on its way. Reclaim the answer block.
			;Reclaim the PDB.  Dismiss.

DATA
DODDTMES:  ASCIE </SWITCHING TO DDT/>
CODE

DONOTICE:	;Service routine
COMMENT ⊗ The assumption is that someone has moved the arm.  Call
MOVED to invalidate all devices and cause good values to be
generated.  Return a response of the form "DONE", unless something
goes wrong, in which case the answer will be "ERROR (NOTICE)", which
really ought not to happen.  ⊗

	JSR PC,NOTICE	;Do the updating.
	;prepare the answer. Note that TACK and TACKVAL take a string pointer
	; in R0 and leave it right afterwords.
	MOV ANPTR(R2),R0;R0 ← answer pointer
	MOV #DONEMES,R1	;
	JSR PC,TACK	;Tack on "DONE "

	;ANPTR(R2) = end of the message.  ANSBUF(R2) = front of the message
	JMP SNDANS	;Send it winging on its way. Reclaim the answer block.
			;Reclaim the PDB.  Dismiss.
;  Driver for test of communications, ALINIT, ALKILL

.IFNZ DEBUG

temp == %OFFSE	;Save the current offset
.OFFSET 0	;We want to use real physical addresses here for the kernel

	PUTLOC JOBDAT, MAINBL
	PUTLOC JOBSA, START
	PUTLOC JOBDM, USRDM

.OFFSET temp	;Restore Offset

DATA
MAINBL:	PDBLK 1,200,S	;Makes a process descriptor for main process
CODE
START:	JSR PC,IOINIT	;
	JSR PC,FRINIT	;
	CLR NOTB10
	CLR NOTB11
	EVMAK		;Create and signal once the AL interlock event.
	MOV (SP),ALDEVT	;
	EVSIG		;
	CLR WAITQ+QNEXT	;
	JMP SERVER	;No, he'll never return


GETARG:	MOV R0,FAKE	;
	MOV #FAKE1,R0	;
	RTS PC

DATA
FAKE:	.BLKW 2	;Long enough for floating
FAKE1:	FAKE
CODE

ROUTINE GETVAL,<GTV.ARG>
	MOV GTV.ARG(RF),R0
	RTS PC

ROUTINE CHANGE,<CHG.ND,CHG.VN>
	RTS PC

GETSCA:	MOV #FAKE,R0	;
	MOV R0,-(R3)	;
	RTS PC		;

GETTRN:	MOV #60,R0	;
	JSR PC,GTFREE	;
	MOV R0,-(R3)	;

TACKVAL:
COMMENT ⊗ R1 = LOC[value], R0 ← where to put it ⊗
	MOV #FAKEMES,R1	;
	JMP TACK	;
DATA
FAKEMES:ASCIE </999.999/>
CODE

.ENDC

DATA
ALPDB:	PDBLK 2,150,S	;Makes a process descriptor for server
CODE

ALINIT:
COMMENT ⊗ Start up one copy of the server as a separate job. ⊗
	EVMAK			;Create and signal once the AL interlock event.
	MOV (SP),ALDEVT
	EVSIG
	CLR WAITQ+QNEXT
	CLR NOTB11
	CLR NOTB10
	MOV #1,ALLIVE		;Indicate that the AL interpreter is alive
	MOV #20,R0		;R3 stack space
	JSR PC,GTFREE
	ADD #40,R0		;to end of space
	MOV #ALPDB,R1		;R1 ← LOC[ALAID process descriptor]
	BIS #UGRSAV+USKSAV,PDBSTA(R1)	;Use saved registers.
	MOV R0,PDBR3(R1)	;Store away the R3 stack pointer.
	MOV USKMAX(R1),USKP(R1)	;Make sure we have a good stack pointer
	SCHEDU R1,#SERVER,#USRDM,#2 ;Cause the new process to be started, suspended
	RTS PC

ALKILL:	CLR ALLIVE		;Indicate that the AL interpreter is dead
	RTS PC
;  BUGS
COMMENT ⊗
DOSTART calls SPAWN, which expects R4 to point to a valid ISB.  This
is not always possible, so either SPAWN should be changed, or, more
likely, a special version of SPAWN should be used that sets up an ISB
from scratch, much as is done in AL(3P).
⊗